Usenet 1993 July

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume23 / lome / part04 < prev next >

Wrap

Internet Message Format | 1991-01-08 | 52.3 KB

Path: j.cc.purdue.edu!mentor.cc.purdue.edu!noose.ecn.purdue.edu!samsung!zaphod.mps.ohio-state.edu!wuarchive!uunet!papaya.bbn.com!rsalz From: rsalz@bbn.com (Rich Salz) Newsgroups: comp.sources.unix Subject: v23i054: Line oriented macro processor, Part04/09 Message-ID: <3029@litchi.bbn.com> Date: 29 Nov 90 17:42:34 GMT Organization: BBN Systems and Technologies, Cambridge MA Lines: 2011 Approved: rsalz@uunet.UU.NET Submitted-by: Darren New <new@ee.udel.edu> Posting-number: Volume 23, Issue 54 Archive-name: lome/part04 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 4 (of 9)." # Contents: LOME/LOME.h LOME/LOME.mac LOME/LOME1.out LOME/LOME5.c # LOME/SCMdebug.mac PPL/PPLUnix.c TFS/TFS.h # Wrapped by new@estelle.ee.udel.edu on Tue Aug 14 16:09:58 1990 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'LOME/LOME.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/LOME.h'\" else echo shar: Extracting \"'LOME/LOME.h'\" $6152 characters$ sed "s/^X//" >'LOME/LOME.h' <<'END_OF_FILE' X/* X * LOME.h X * Line Oriented Macro Expander Header file X * Copyright 1989 Darren New X * X */ X X#include "PPL.h" X#include "MacroIO.h" X X/* ADJUSTABLE PARAMETERS: */ X X#define MAXmacrochars 15000 /* max # of macro header or body characters */ X#define MAXvarnames 500 /* max # of variables allowed */ X#define MAXnests 200 /* max # of nested macro expansions */ X#define MAXustack 50 /* max # items on user stack */ X#define MAXstreams 20 /* max # items on input stream stack */ X Xtypedef int moffs; /* type of in which will hold -1..MAXmacrochars */ X X/* NON-ADJUSTABLE DECLARATIONS: */ X X#define O_ESC 0 /* escape */ X#define O_PHC 1 /* placeholder character */ X#define O_HEOL 2 /* header end-of-line */ X#define O_SUBS 3 /* substitution */ X#define O_BEOL 4 /* body end-of-line */ X#define O_ZERO 5 /* digit zero */ X#define O_UCA 6 /* first upper-case letter */ X#define O_LCA 7 /* first lower-case letter */ X#define O_UCZ 8 /* last upper-case letter */ X#define O_FILEOP 9 /* file operation character */ X#define O_CTRLOP 10 /* control operation character */ X#define O_OQ 11 /* open quote */ X#define O_CQ 12 /* close quote */ X#define O_OP 13 /* open paren */ X#define O_CP 14 /* close paren */ X#define O_PLUS 15 /* plus sign */ X#define O_MINUS 16 /* minus sign */ X#define O_MULT 17 /* multiplication sign */ X#define O_DIV 18 /* division sign */ X#define O_FETCH 19 /* the fetch character */ X#define O_RADIX 20 /* the radix character */ X#define O_RESC1 21 /* reserved char 1 */ X#define O_RESC2 22 /* reserved char 2 */ X#define O_RESC3 23 /* reserved char 3 */ X#define O_RESC4 24 /* reserved char 4 */ X#define O_SPACE 25 /* space character */ X#define O_FCASE 26 /* case specific flag */ X#define O_FBLANK 27 /* blank output line flag */ X#define O_FSPACE 28 /* leading space flag */ X#define O_FMATCH 29 /* required match flag */ X#define O_FSYMGEN 30 /* symbol generator advance flag */ X#define O_FSTACKUNDER 31 /* user stack underflow flag */ X#define O_FSTACKSIZE 32 /* initial user stack size flag */ X#define O_FECHO 33 /* echo flag */ X#define O_RESF1 34 /* reserved flag 1 */ X#define O_RESF2 35 /* reserved flag 2 */ X#define O_RESF3 36 /* reserved flag 3 */ X#define O_RESF4 37 /* reserved flag 4 */ X#define O_last 38 /* size of parameter string */ X Xextern char params[O_last]; /* inputted parameter string */ X X /* Format of macros in macrochar and macroflag: X * header: flag = 0, val=char to match X * flag = 1, val='@' for placeholder X * flag = 2, val=0 for HEOL X * body lines: X * flag = 0 to insert char in constructed line X * flag = 1, val='0'-'9' or 'C' or 'F' followed by X * flag = 1, val='0'-'9' for substitution X * flag=2, val=0 for BEOL X * flag=3, val=0 for end of body (after last BEOL) X */ X Xextern unsigned char * macrochar; /* chars of macros (dyn alc) */ Xextern unsigned char * macroflag; /* flags of macros (dyn alc) */ Xextern moffs macrosize; /* size of macros loaded */ X Xextern str varname[MAXvarnames]; /* names of variables */ Xextern str varval[MAXvarnames]; /* values of variables */ X Xextern str ustack[MAXustack]; /* values of user stack */ Xextern short ustacksize; /* # items on ustack */ X Xstruct traceback_struct { /* one entry on traceback stack */ X moffs retoffs; /* macro offset to return to */ X str inp; /* matched line */ X str p[10]; /* parameter values */ X }; X Xextern struct traceback_struct tstack[MAXnests]; /* traceback stack */ Xextern int tstacksize; X X#define Sretoffs (tstack[tstacksize-1].retoffs) X#define Sinp (tstack[tstacksize-1].inp) X#define Sp (tstack[tstacksize-1].p) X#define Sp0 (tstack[tstacksize-1].p[0]) X#define Sp1 (tstack[tstacksize-1].p[1]) X#define Sp2 (tstack[tstacksize-1].p[2]) X#define Sp3 (tstack[tstacksize-1].p[3]) X#define Sp4 (tstack[tstacksize-1].p[4]) X#define Sp5 (tstack[tstacksize-1].p[5]) X#define Sp6 (tstack[tstacksize-1].p[6]) X#define Sp7 (tstack[tstacksize-1].p[7]) X#define Sp8 (tstack[tstacksize-1].p[8]) X#define Sp9 (tstack[tstacksize-1].p[9]) X X#define ADDTOLINE(c) (consline[conslinesize++] = (c)) X#define ENDLINE() (consline[conslinesize] = 0) X Xextern short sstack[MAXstreams]; /* input stream stack */ Xextern short sstacksize; /* # items on sstack */ X Xextern short outstream; /* current output stream */ Xextern short instream; /* current input stream */ X Xextern char consline[BIGLINE]; /* constructed line */ Xextern short conslinesize; /* chars on cons line */ X Xextern long symgenval; /* symbol generator value */ X Xextern long skipping; /* skip value flag */ X Xextern bool quitting; /* abnormally exitting */ X X/* Functions: */ X X /* the two main functions */ Xextern bool LoadMacros(int); /* load macros from stream */ Xextern void ParseFiles(int); /* parse source from stream */ X X /* the support functions */ Xextern void AddLineToStack(str);/* push and parse new line */ Xextern int BalMatch(str,str,char*); X /* match balanced string */ Xextern void FindMatch(void); /* match input line on top of traceback */ Xextern void ExpandLine(void); /* expand macro on top of traceback */ Xextern void DoCtrlOp(int); /* do control op given as arg */ Xextern void DoFileOp(int); /* do file op given as arg */ Xextern void DoSubsOp(int,int); /* do substitution=arg2 on param=arg1 */ X X /* the general functions called from several places */ Xextern void Message(str); /* output a 4-char error message */ Xextern void TraceBack(void); /* display traceback */ Xextern void PopTStack(void); /* pop and discard top of traceback */ Xextern void IntToStr(long,str); /* convert integer to string */ Xextern long StrToInt(str); /* convert string to integer */ Xextern long StrToIntErr(str,str*); /* convert string to integer w/ errors */ Xextern void InsNumber(long); /* insert text of number into line */ Xextern str VarLookup(str); /* look up value of variable */ Xextern void VarSetVal(str,str); /* set value of variable */ X X END_OF_FILE if test 6152 -ne `wc -c <'LOME/LOME.h'`; then echo shar: \"'LOME/LOME.h'\" unpacked with wrong size! fi # end of 'LOME/LOME.h' fi if test -f 'LOME/LOME.mac' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/LOME.mac'\" else echo shar: Extracting \"'LOME/LOME.mac'\" $7493 characters$ sed "s/^X//" >'LOME/LOME.mac' <<'END_OF_FILE' XFILE: LOME.mac XThis is the input file for the regression testing of LOME. X X\@.@$0AaZFC`'()+-*/?!XXXX 011000000000 XTest1a @ XThis should say "`alpha '": "@00" XThis should say "alpha ": "@01" X$$ X XTest1. XTesting parameter substitution ops...$This should not appear XThere should be exactly one blank line next X$ Nothing but a blank line should appear here XTest1a `alpha '$ XThis should have nothing between quotes: "@00" XONEONE@27$ Assign "ONEONE" to parameter 2 XThis should say "ONEONE": "@20" XFOUR@28$ set var ONEONE to FOUR XThis should say "FOUR": "@23" XThis should say "6": "@26" XThis should be I/O code for "O": "@25" XThis should say "0": "@55" XThis should say "0" also: "@56" XThree different numbers next: @54 @54 @54 XThis should say "FOUR" again: "@24" XSIX@37$ Assign "SIX" to parameter 3 XThis should say the same number three times: @34 @34 @34 XThese are the I/O codes of A Z a z 0 + - * / ( ) ` ' ? !: XTest2Help A XTest2Help Z XTest2Help a XTest2Help z XTest2Help 0 XTest2Help + XTest2Help - XTest2Help * XTest2Help / XTest2Help ( XTest2Help ) XTest2Help ` XTest2Help ' XTest2Help ? XTest2Help ! XTesting substitution ops (except math) complete! X$$ X XTest2Help @. XThe I/O code for "@00" is "@05" X$$ X XTest3. test control ops XTesting control ops... XTest3a$ test skips single case XTest3c$ test push and pop X$$ XTest3a. test skips single case XThis tests skips next. Following lines should be numbered and consecutive. XIf a line starting with X appears, an error exists. X01 - About to test skip eq XSkip 1 if xyzzy eq xyzzy XXA - If this appears, skip eq does not skip on eq XSkip 1 if xyzzy eq pdq X02 - If this does not appear, skip eq skips on ne X03 - End test of skip eq. About to test skip ne. XSkip 1 if lotus ne xyzzy XXB - If this appears, skip ne does not skip on ne XSkip 1 if lotus ne lotus X04 - If this does not appear, skip ne skips on eq X05 - end test of skip ne. about to test skip lt. XSkip 1 if 100 lt 100 X06 - If this does not appear, 100 lt 100 skips XSkip 1 if 100 lt 200 XXC - If this appears, 100 lt 200 did not skip XSkip 1 if -100 lt 50 XXD - If this appears, -100 lt 200 did not skip XSkip 1 if 50 lt -100 X07 - If this does not appear, 50 lt -100 skips X08 - end test of skip lt. about to test skip begins. XSkip 1 if xyzzy begins xyzzypdq XXE - If this appears, xyzzy begins xyzzypdq does not skip XSkip 1 if xyzzy begins xyzzy XXF - If this appears, xyzzy begins xyzzy does not skip XSkip 1 if xyzzy begins xyzz X09 - If this does not appear, xyzzy begins xyzz skips X10 - About to test multi-level skips XTest3b1 X11 - End of numbered lines (for now) X$$ XTest3b1. XTest3b2 XXX - Multi level skip not skipping enough X$$ XTest3b2. XTest3b3 XXX - Multi level skip not skipping enough X$$ XTest3b3. XSkip -4 if 0 lt 1$ -4 because Skip @ if @ lt @ is also a macro XXX - Multi level skip not skipping enough X$$ XTest3c. test push and pop XONE@C5TWO@C5THREE@C5 X2@C6 X@C6 X3@C6 XThis should say "THREE ONE": "@20 @30" X$$ X XTest4. Test skipping input directly XAbout to test input skipping. XSkip 3 if 1 lt 2 XXX - This should not appear. X$$ XSkip @ if @ eq @. string equal comparison X@C2$ X$$ XSkip @ if @ ne @. string notequal comparison. X@C3$ X$$ XSkip @ if @ lt @. numeric lessthan comparison. X@C1$ X$$ XSkip @ if @ begins @. initial string comparison. X@C4$ X$$ X XTest5. Decimal Loop constructs XStart Decimal Loop Tests XThis should print "test5a:(-3)" through "test5a:(19)" and then "stuff" XDecimal loop -3 19 test5a: XThe next line should say "test5b:(5)" and then "stuff" XDecimal loop 5 5 test5b: XThe next line should say "stuff" and then "no loop" w/o anything between XDecimal loop 8 7 test5c: Xno loop XThis should say "test5d1:(1)" and "test5d1:(2)" and then NO "stuff" XDecimal loop 1 5 test5d: XEnd Decimal Loop Tests X$$ XDecimal loop @ @ @ X@21@C7stuff X$$ Xtest5d:(@). XSkip -3 if @00 eq 3 Xtest5d1:(@00) X$$ X XTest6. String Loop constructs XStart String Loop Tests XThis should say "t6:A" "t6:C" "t6:F" and then "stuff" XString loop !ACF!!t6:! XThis should print out the eval example from the docs XString loop !AB+(B*CD)*E+-FG!+-*/!EVAL! XThis should print out the XX example from the docs XAB(CD`@07 X()`'@17 XXX@C8 XEnd String Loop Tests X$$ XString loop !@!@!@! X@21@C8stuff X$$ X XTest7a. Test some file ops X1VERY IMPORTANT TEST MESSAGE SHOULD GO TO CONSOLE@F7 X9note not so very imporant test message should be suppressed@F7 XX-X-X-X-X ONE X4@F2$ send output to stream 4 XFish Fish Fish XThis line should go onto stream 4 and then be copied to output. XThis should also go to stream 4 and be copied to output also. XOnce more this goes to stream 4 and back. XEND OF INPUT X3@F2$ reset output back to stream 3 again XX-X-X-X-X TWO X4@F0$ rewind stream 4 X4ZEND OF INPUT@F1$ copy stream 4 to input until "END OF INPUT" found XX-X-X-X-X THREE X4@F0$ rewind stream 4 X4X@F3$ read stream four and revert at EOF X$$ force input stream 4 to read XTest7b. more file operations XX-X-X-X-X FOUR X4@F0$ rewind stream 4 X47@F8$ read a line from 4 and put it in P7 XX-X-X-X-X FIVE XThis should say "Fish Fish Fish": "@70" XZThe next line should say "TestMath" only@F4 XZTestMath@F4 XThis should output the F5 example from LOME.doc: XZERO@0723@17 XZ 000000 11111 000 HELP22ME@F5 XX-X-X-X-X SIX X49@F1$ Copy stream 4 from current to EOF to scratch 9 X9@F0$ rewind scratch 9 X9Z@F1$ Copy 9 to output until EOF XX-X-X-X-X SEVEN X9@F0$ rewind nine again X9ZOnce@F1$ copy it again, stopping at Once... XX-X-X-X-X EIGHT X9t:LOME9.out@F0$ rewind nine and rename it to t:LOME9.out X9This should go only to t:LOME9.out@F4 XX-X-X-X-X NINE X$$ X XTestMath. XTest mathematical substitutions: XZIP@07$ put "ZIP" into parameter zero X7294@08$ put "7294" into variable ZIP XNo operators: This should say "ZIP": "@02" X3 9 +@27 XAddition: This should say "12": "@22" X3 9 *@27 XMultiplication: This should say "27": "@22" X143 149 -@27 XSubtraction: This should say "-6": "@22" X3 9 /@27 XDivision w/ truncation: This should say "0": "@22" X-34 5 /@27 XDivision w/o truncation: This should say "-6": "@22" X -25 @27 XLeading minus: This should say "-25": "@22" X 25 5 * 18 3 / + -1 * @27 XComplex formulas with leading minuses: This should say "-131": "@22" XZIP ?@17$ put "ZIP ?" into parameter one XFetch: This should say "7294": "@12" X ZIP ? @17$ put " ZIP ? " into parameter one XFetch with extra spaces: This should say "7294": "@12" XZIP ? 18 /@17 XFetch then math: This should say "405": "@12" X +3 +12 -2 / +3 * *@27 XComplex leading plusses and minuses: this should say "-54": "@22" XRadix tests: XThe following should give 0 to 9 and A to Z after TM1a: and then stuff XDecimal loop 0 35 TM1: XThe following should give -Z to -A and -9 to -1 and 0 after TM1a: and then stuff XDecimal loop -35 0 TM1: XThe following should give -2Z to -20 to -1Z to -10 to -Z to -1 to 0 XDecimal loop -107 0 TM1: XThe following should give 0 to 35 after TM3a: and then stuff XString loop !0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ!!TM3:! XThe following should give 0 to 35 again after TM3a: and then stuff XString loop !0123456789abcdefghijklmnopqrstuvwxyz!!TM3:! XThe following should give 2 to 36 after TM3a: and then stuff XString loop !123456789ABCDEFGHIJKLNNOPQRSTUVWXYZ!!TM3b:! XThe following should count from 0 to 15 in binary after TM4a: and then stuff XDecimal loop 0 15 TM4: X +100 9 Z !@27 XRadix with leading plusses: This should say "2S": "@22" XEnd of radix tests. X$$ XTM4:(@). X@00 9 1 !@27TM4a:@22 X$$ XTM3b:@. X10 @00 9 !@27TM3a:@22 X$$ XTM3:@. X@00 z 9 !@27TM3a:@22 X$$ XTM2:(@). X@00 Z 9 !@27TM2a:@22 X$$ XTM1:(@). X@00 9 Z !@27TM1a:@22 X$$ X X END_OF_FILE if test 7493 -ne `wc -c <'LOME/LOME.mac'`; then echo shar: \"'LOME/LOME.mac'\" unpacked with wrong size! fi # end of 'LOME/LOME.mac' fi if test -f 'LOME/LOME1.out' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/LOME1.out'\" else echo shar: Extracting \"'LOME/LOME1.out'\" $7500 characters$ sed "s/^X//" >'LOME/LOME1.out' <<'END_OF_FILE' XThis line should come out unchanged XTesting parameter substitution ops... XThere should be exactly one blank line next X XThis should say "`alpha '": "`alpha '" XThis should say "alpha ": "alpha " XThis should have nothing between quotes: "" XThis should say "ONEONE": "ONEONE" XThis should say "FOUR": "FOUR" XThis should say "6": "6" XThis should be I/O code for "O": "79" XThis should say "0": "0" XThis should say "0" also: "0" XThree different numbers next: 0 1 2 XThis should say "FOUR" again: "FOUR" XThis should say the same number three times: 3 3 3 XThese are the I/O codes of A Z a z 0 + - * / ( ) ` ' ? !: XThe I/O code for "A" is "65" XThe I/O code for "Z" is "90" XThe I/O code for "a" is "97" XThe I/O code for "z" is "122" XThe I/O code for "0" is "48" XThe I/O code for "+" is "43" XThe I/O code for "-" is "45" XThe I/O code for "*" is "42" XThe I/O code for "/" is "47" XThe I/O code for "(" is "40" XThe I/O code for ")" is "41" XThe I/O code for "`" is "96" XThe I/O code for "'" is "39" XThe I/O code for "?" is "63" XThe I/O code for "!" is "33" XTesting substitution ops (except math) complete! XTest2 XTesting control ops... XThis tests skips next. Following lines should be numbered and consecutive. XIf a line starting with X appears, an error exists. X01 - About to test skip eq X02 - If this does not appear, skip eq skips on ne X03 - End test of skip eq. About to test skip ne. X04 - If this does not appear, skip ne skips on eq X05 - end test of skip ne. about to test skip lt. X06 - If this does not appear, 100 lt 100 skips X07 - If this does not appear, 50 lt -100 skips X08 - end test of skip lt. about to test skip begins. X09 - If this does not appear, xyzzy begins xyzz skips X10 - About to test multi-level skips X11 - End of numbered lines (for now) XThis should say "THREE ONE": "THREE ONE" XAbout to test input skipping. XIf this does not appear, input skips skipping too much XStart Decimal Loop Tests XThis should print "test5a:(-3)" through "test5a:(19)" and then "stuff" Xtest5a:(-3) Xtest5a:(-2) Xtest5a:(-1) Xtest5a:(0) Xtest5a:(1) Xtest5a:(2) Xtest5a:(3) Xtest5a:(4) Xtest5a:(5) Xtest5a:(6) Xtest5a:(7) Xtest5a:(8) Xtest5a:(9) Xtest5a:(10) Xtest5a:(11) Xtest5a:(12) Xtest5a:(13) Xtest5a:(14) Xtest5a:(15) Xtest5a:(16) Xtest5a:(17) Xtest5a:(18) Xtest5a:(19) Xstuff XThe next line should say "test5b:(5)" and then "stuff" Xtest5b:(5) Xstuff XThe next line should say "stuff" and then "no loop" w/o anything between Xstuff Xno loop XThis should say "test5d1:(1)" and "test5d1:(2)" and then NO "stuff" Xtest5d1:(1) Xtest5d1:(2) XEnd Decimal Loop Tests XStart String Loop Tests XThis should say "t6:A" "t6:C" "t6:F" and then "stuff" Xt6:A Xt6:C Xt6:F Xstuff XThis should print out the eval example from the docs XEVAL(+)AB XEVAL(*)(B*CD) XEVAL(+)E XEVAL(-) XEVAL()FG Xstuff XThis should print out the XX example from the docs XXX(\()AB XXX(`)CD XEnd String Loop Tests XX-X-X-X-X ONE XX-X-X-X-X TWO XFish Fish Fish XThis line should go onto stream 4 and then be copied to output. XThis should also go to stream 4 and be copied to output also. XOnce more this goes to stream 4 and back. XX-X-X-X-X THREE XFish Fish Fish XThis line should go onto stream 4 and then be copied to output XThis should also go to stream 4 and be copied to output also XOnce more this goes to stream 4 and back XEND OF INPUT XX-X-X-X-X FOUR XX-X-X-X-X FIVE XThis should say "Fish Fish Fish": "Fish Fish Fish" XThe next line should say "TestMath" only XTestMath XThis should output the F5 example from LOME.doc: X ZERO 23 ZER HELP ME XX-X-X-X-X SIX XThis line should go onto stream 4 and then be copied to output. XThis should also go to stream 4 and be copied to output also. XOnce more this goes to stream 4 and back. XEND OF INPUT XX-X-X-X-X SEVEN XThis line should go onto stream 4 and then be copied to output. XThis should also go to stream 4 and be copied to output also. XX-X-X-X-X EIGHT XX-X-X-X-X NINE XTest mathematical substitutions: XNo operators: This should say "ZIP": "ZIP" XAddition: This should say "12": "12" XMultiplication: This should say "27": "27" XSubtraction: This should say "-6": "-6" XDivision w/ truncation: This should say "0": "0" XDivision w/o truncation: This should say "-6": "-6" XLeading minus: This should say "-25": "-25" XComplex formulas with leading minuses: This should say "-131": "-131" XFetch: This should say "7294": "7294" XFetch with extra spaces: This should say "7294": "7294" XFetch then math: This should say "405": "405" XComplex leading plusses and minuses: this should say "-54": "-54" XRadix tests: XThe following should give 0 to 9 and A to Z after TM1a: and then stuff XTM1a:0 XTM1a:1 XTM1a:2 XTM1a:3 XTM1a:4 XTM1a:5 XTM1a:6 XTM1a:7 XTM1a:8 XTM1a:9 XTM1a:A XTM1a:B XTM1a:C XTM1a:D XTM1a:E XTM1a:F XTM1a:G XTM1a:H XTM1a:I XTM1a:J XTM1a:K XTM1a:L XTM1a:M XTM1a:N XTM1a:O XTM1a:P XTM1a:Q XTM1a:R XTM1a:S XTM1a:T XTM1a:U XTM1a:V XTM1a:W XTM1a:X XTM1a:Y XTM1a:Z Xstuff XThe following should give -Z to -A and -9 to -1 and 0 after TM1a: and then stuff XTM1a:-Z XTM1a:-Y XTM1a:-X XTM1a:-W XTM1a:-V XTM1a:-U XTM1a:-T XTM1a:-S XTM1a:-R XTM1a:-Q XTM1a:-P XTM1a:-O XTM1a:-N XTM1a:-M XTM1a:-L XTM1a:-K XTM1a:-J XTM1a:-I XTM1a:-H XTM1a:-G XTM1a:-F XTM1a:-E XTM1a:-D XTM1a:-C XTM1a:-B XTM1a:-A XTM1a:-9 XTM1a:-8 XTM1a:-7 XTM1a:-6 XTM1a:-5 XTM1a:-4 XTM1a:-3 XTM1a:-2 XTM1a:-1 XTM1a:0 Xstuff XThe following should give -2Z to -20 to -1Z to -10 to -Z to -1 to 0 XTM1a:-2Z XTM1a:-2Y XTM1a:-2X XTM1a:-2W XTM1a:-2V XTM1a:-2U XTM1a:-2T XTM1a:-2S XTM1a:-2R XTM1a:-2Q XTM1a:-2P XTM1a:-2O XTM1a:-2N XTM1a:-2M XTM1a:-2L XTM1a:-2K XTM1a:-2J XTM1a:-2I XTM1a:-2H XTM1a:-2G XTM1a:-2F XTM1a:-2E XTM1a:-2D XTM1a:-2C XTM1a:-2B XTM1a:-2A XTM1a:-29 XTM1a:-28 XTM1a:-27 XTM1a:-26 XTM1a:-25 XTM1a:-24 XTM1a:-23 XTM1a:-22 XTM1a:-21 XTM1a:-20 XTM1a:-1Z XTM1a:-1Y XTM1a:-1X XTM1a:-1W XTM1a:-1V XTM1a:-1U XTM1a:-1T XTM1a:-1S XTM1a:-1R XTM1a:-1Q XTM1a:-1P XTM1a:-1O XTM1a:-1N XTM1a:-1M XTM1a:-1L XTM1a:-1K XTM1a:-1J XTM1a:-1I XTM1a:-1H XTM1a:-1G XTM1a:-1F XTM1a:-1E XTM1a:-1D XTM1a:-1C XTM1a:-1B XTM1a:-1A XTM1a:-19 XTM1a:-18 XTM1a:-17 XTM1a:-16 XTM1a:-15 XTM1a:-14 XTM1a:-13 XTM1a:-12 XTM1a:-11 XTM1a:-10 XTM1a:-Z XTM1a:-Y XTM1a:-X XTM1a:-W XTM1a:-V XTM1a:-U XTM1a:-T XTM1a:-S XTM1a:-R XTM1a:-Q XTM1a:-P XTM1a:-O XTM1a:-N XTM1a:-M XTM1a:-L XTM1a:-K XTM1a:-J XTM1a:-I XTM1a:-H XTM1a:-G XTM1a:-F XTM1a:-E XTM1a:-D XTM1a:-C XTM1a:-B XTM1a:-A XTM1a:-9 XTM1a:-8 XTM1a:-7 XTM1a:-6 XTM1a:-5 XTM1a:-4 XTM1a:-3 XTM1a:-2 XTM1a:-1 XTM1a:0 Xstuff XThe following should give 0 to 35 after TM3a: and then stuff XTM3a:0 XTM3a:1 XTM3a:2 XTM3a:3 XTM3a:4 XTM3a:5 XTM3a:6 XTM3a:7 XTM3a:8 XTM3a:9 XTM3a:10 XTM3a:11 XTM3a:12 XTM3a:13 XTM3a:14 XTM3a:15 XTM3a:16 XTM3a:17 XTM3a:18 XTM3a:19 XTM3a:20 XTM3a:21 XTM3a:22 XTM3a:23 XTM3a:24 XTM3a:25 XTM3a:26 XTM3a:27 XTM3a:28 XTM3a:29 XTM3a:30 XTM3a:31 XTM3a:32 XTM3a:33 XTM3a:34 XTM3a:35 Xstuff XThe following should give 0 to 35 again after TM3a: and then stuff XTM3a:0 XTM3a:1 XTM3a:2 XTM3a:3 XTM3a:4 XTM3a:5 XTM3a:6 XTM3a:7 XTM3a:8 XTM3a:9 XTM3a:10 XTM3a:11 XTM3a:12 XTM3a:13 XTM3a:14 XTM3a:15 XTM3a:16 XTM3a:17 XTM3a:18 XTM3a:19 XTM3a:20 XTM3a:21 XTM3a:22 XTM3a:23 XTM3a:24 XTM3a:25 XTM3a:26 XTM3a:27 XTM3a:28 XTM3a:29 XTM3a:30 XTM3a:31 XTM3a:32 XTM3a:33 XTM3a:34 XTM3a:35 Xstuff XThe following should give 2 to 36 after TM3a: and then stuff XTM3a:2 XTM3a:3 XTM3a:4 XTM3a:5 XTM3a:6 XTM3a:7 XTM3a:8 XTM3a:9 XTM3a:10 XTM3a:11 XTM3a:12 XTM3a:13 XTM3a:14 XTM3a:15 XTM3a:16 XTM3a:17 XTM3a:18 XTM3a:19 XTM3a:20 XTM3a:21 XTM3a:22 XTM3a:24 XTM3a:24 XTM3a:25 XTM3a:26 XTM3a:27 XTM3a:28 XTM3a:29 XTM3a:30 XTM3a:31 XTM3a:32 XTM3a:33 XTM3a:34 XTM3a:35 XTM3a:36 Xstuff XThe following should count from 0 to 15 in binary after TM4a: and then stuff XTM4a:0 XTM4a:1 XTM4a:10 XTM4a:11 XTM4a:100 XTM4a:101 XTM4a:110 XTM4a:111 XTM4a:1000 XTM4a:1001 XTM4a:1010 XTM4a:1011 XTM4a:1100 XTM4a:1101 XTM4a:1110 XTM4a:1111 Xstuff XRadix with leading plusses: This should say "2S": "2S" XEnd of radix tests. XEnd of Tests! END_OF_FILE if test 7500 -ne `wc -c <'LOME/LOME1.out'`; then echo shar: \"'LOME/LOME1.out'\" unpacked with wrong size! fi # end of 'LOME/LOME1.out' fi if test -f 'LOME/LOME5.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/LOME5.c'\" else echo shar: Extracting \"'LOME/LOME5.c'\" $6778 characters$ sed "s/^X//" >'LOME/LOME5.c' <<'END_OF_FILE' X/* X * LOME5.c X * Line Oriented Macro Expander - DoCtrlOp() X * Copyright 1989 Darren New X * X */ X X#include "LOME.h" X Xvoid DoCtrlOp ARGS1(int,op /* the operation number */) X{ X int i; X X assert(0 < tstacksize); X X switch (op) { X X case 0: { /* stop */ X if (conslinesize != 0) { X char * t = consline; X MPutChar(0); X while (*t) MPutChar(*t++); X MPutChar(0); X MPutBuff(outstream); X TraceBack(); X } X quitting = TRUE; X break; X } X X case 1: { /* skip p0 if val(p1) < val(p2) */ X if (StrToInt(Sp1) < StrToInt(Sp2)) { X skipping = StrToInt(Sp0); X while (macroflag[Sretoffs] != 2) X Sretoffs += 1; X } X break; X } X X case 2: { /* skip p0 if "p1" eq "p2" */ X X bool m = TRUE; /* matched? */ X bool c = params[O_FCASE] == params[O_ZERO]; /* case indep? */ X char c1, c2; /* chars being compared */ X X if (Sp1 == NULL) Sp1 = PLStrDup(""); X if (Sp2 == NULL) Sp2 = PLStrDup(""); X X if (strlen(Sp1) != strlen(Sp2)) m = FALSE; X X for (i = 0; m && (c1 = Sp1[i]) && (c2 = Sp2[i]); i++) { X m = c1 == c2; X if (!m && c) { X /* see if case independence will match */ X if (params[O_UCA] <= c1 && c1 <= params[O_UCZ]) X c1 = c1 - params[O_UCA] + params[O_LCA]; X if (params[O_UCA] <= c2 && c2 <= params[O_UCZ]) X c2 = c2 - params[O_UCA] + params[O_LCA]; X m = c1 == c2; X } X } X X if (m) { X skipping = StrToInt(Sp0); X while (macroflag[Sretoffs] != 2) X Sretoffs += 1; X } X X break; X } X X case 3: { /* skip p0 if "p1" ne "p2" */ X X bool m = TRUE; /* matched? */ X bool c = params[O_FCASE] == params[O_ZERO]; /* case indep? */ X char c1, c2; /* chars being compared */ X X if (Sp1 == NULL) Sp1 = PLStrDup(""); X if (Sp2 == NULL) Sp2 = PLStrDup(""); X X if (strlen(Sp1) != strlen(Sp2)) m = FALSE; X X for (i = 0; m && (c1 = Sp1[i]) && (c2 = Sp2[i]); i++) { X m = c1 == c2; X if (!m && c) { X /* see if case independence will match */ X if (params[O_UCA] <= c1 && c1 <= params[O_UCZ]) X c1 = c1 - params[O_UCA] + params[O_LCA]; X if (params[O_UCA] <= c2 && c2 <= params[O_UCZ]) X c2 = c2 - params[O_UCA] + params[O_LCA]; X m = c1 == c2; X } X } X X if (!m) { X skipping = StrToInt(Sp0); X while (macroflag[Sretoffs] != 2) X Sretoffs += 1; X } X X break; X } X X case 4: { /* skip p0 if "p1" starts "p2" */ X X bool m = TRUE; /* matched? */ X bool c = params[O_FCASE] == params[O_ZERO]; /* case indep? */ X char c1, c2; /* chars being compared */ X X if (Sp1 == NULL) Sp1 = PLStrDup(""); X if (Sp2 == NULL) Sp2 = PLStrDup(""); X X for (i = 0; m && (c1 = Sp1[i]) && (c2 = Sp2[i]); i++) { X m = c1 == c2; X if (!m && c) { X /* see if case independence will match */ X if (params[O_UCA] <= c1 && c1 <= params[O_UCZ]) X c1 = c1 - params[O_UCA] + params[O_LCA]; X if (params[O_UCA] <= c2 && c2 <= params[O_UCZ]) X c2 = c2 - params[O_UCA] + params[O_LCA]; X m = c1 == c2; X } X } X X if (Sp1[i] == 0) { X skipping = StrToInt(Sp0); X while (macroflag[Sretoffs] != 2) X Sretoffs += 1; X } X X break; X } X X case 5: { /* push ustack */ X if (ustacksize == MAXustack) { X Message("FSTK"); X TraceBack(); X quitting = TRUE; X } X else { X ustack[ustacksize++] = PLStrDup(consline); X } X break; X } X X case 6: { /* pop ustack */ X if (0 < ustacksize) { X if (0 < conslinesize) { X int p = consline[0] - params[O_ZERO]; X if (0 <= p && p <= 9) { X if (Sp[p]) PLFreeMem(Sp[p]); X Sp[p] = PLStrDup(ustack[ustacksize-1]); X } X else { X Message("FORM"); X TraceBack(); X quitting = TRUE; X } X } X ustacksize -= 1; X PLFreeMem(ustack[ustacksize]); X ustack[ustacksize] = NULL; X } X else { X if (params[O_ZERO] == params[O_FSTACKUNDER]) { X Message("ESTK"); X TraceBack(); X quitting = TRUE; X } X } X break; X } X X case 7: { /* decimal loop */ X char buf[BIGLINE]; X long p0 = StrToInt(Sp0); X long p1 = StrToInt(Sp1); X if (p0 <= p1) { X /* build new macro line */ X ADDTOLINE(params[O_OP]); X InsNumber(p0); X ADDTOLINE(params[O_CP]); X ENDLINE(); X /* update local parameters for next iteration */ X if (Sp0 != NULL) PLFreeMem(Sp0); X IntToStr(p0 + 1, buf); X Sp0 = PLStrDup(buf); X /* patch return stack by looking for prev BEOL or HEOL */ X while (macroflag[Sretoffs -= 1] != 2) X ; X Sretoffs += 1; X /* after patching my ret addr, add new stack frame */ X AddLineToStack(consline); X } X break; X } X X case 8: { /* string loop */ X char buf[BIGLINE]; X if (Sp0 && *Sp0) { X if (Sp1 == NULL || *Sp1 == 0) { /* individual characters */ X /* build constructed line */ X ADDTOLINE(*Sp0); X ENDLINE(); X /* update local parameters for next iteration */ X strcpy(buf, Sp0 + 1); X PLFreeMem(Sp0); X Sp0 = PLStrDup(buf); X } X else { /* groups of characters */ X char next; X int mlen; X /* match string */ X mlen = BalMatch(Sp0, Sp1, &next); X if (next) { /* not at end */ X ADDTOLINE(params[O_OP]); X if (next == params[O_OP] || next == params[O_CP]) X ADDTOLINE(params[O_ESC]); X ADDTOLINE(next); X ADDTOLINE(params[O_CP]); X for (i = 0; i < mlen; i++) X ADDTOLINE(Sp0[i]); X } X else { /* at end */ X ADDTOLINE(params[O_OP]); X ADDTOLINE(params[O_CP]); X for (i = 0; i < mlen; i++) X ADDTOLINE(Sp0[i]); X } X ENDLINE(); X if (Sp0[mlen]) { /* still some left */ X strcpy(buf, &Sp0[mlen + 1]); /* skip mchars too */ X PLFreeMem(Sp0); X Sp0 = PLStrDup(buf); X } X else { /* all done */ X PLFreeMem(Sp0); X Sp0 = NULL; X } X } X /* patch return stack by looking for prev BEOL or HEOL */ X /* This is what actually causes the iteration */ X while (macroflag[Sretoffs -= 1] != 2) X ; X Sretoffs += 1; X /* after patching my ret addr, add new stack frame */ X AddLineToStack(consline); X } X break; X } X X case 9: { X Message("NYET"); X TraceBack(); X break; X } X X } X X consline[conslinesize = 0] = 0; /* clear constructed line */ X if (macroflag[Sretoffs] == 2) /* skip trailing BEOL if there */ X Sretoffs += 1; X X /* handle skips locally if possible */ X if (skipping < 0) { X /* negative skips discard traceback stack entries */ X while (skipping < 0 && 0 < tstacksize) { X PopTStack(); X skipping += 1; X } X skipping = 0; X } X else if (0 < skipping) { X /* positive skips skip lines */ X while (0 < skipping && 0 < tstacksize) { X while (2 != macroflag[Sretoffs] && 3 != macroflag[Sretoffs]) X Sretoffs += 1; X if (3 == macroflag[Sretoffs]) { X PopTStack(); /* reached end of macro body */ X } X else { X skipping -= 1; /* reached end of line */ X Sretoffs += 1; /* skip BEOL marker */ X } X } X /* here, if lines remain, ParseFile will skip them. */ X } X X } X X END_OF_FILE if test 6778 -ne `wc -c <'LOME/LOME5.c'`; then echo shar: \"'LOME/LOME5.c'\" unpacked with wrong size! fi # end of 'LOME/LOME5.c' fi if test -f 'LOME/SCMdebug.mac' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'LOME/SCMdebug.mac'\" else echo shar: Extracting \"'LOME/SCMdebug.mac'\" $7108 characters$ sed "s/^X//" >'LOME/SCMdebug.mac' <<'END_OF_FILE' XFILE: SCMdebug.mac XThis file contains the macro definitions for SCM, the Simple Character XManipulation language. This file must be changed from implementation to Ximplementation. This file can serve as the first argument to Comp1. XThis particular version is for generating C source code where longs Xare 32 bits, shorts are more than 8 bits, and the MacroIO package in C Xis available. This version generates inline DEBUGF statements. X X0$.$> XBEGIN PROGRAM. X/* X * SCM Executable program. X * Generated by SCM Macros. X * X */ X#include "PPL.h" X#include "MacroIO.h" X /* */ X/* Declare the memory cells */ X#define MEMSIZ 6000 Xlong MEM[MEMSIZ]; X /* */ X/* Declare the registers */ Xshort FA, FB, FC, FD, FE, FF, FG, FH, FI, FJ, FK, FL, FM; Xshort FN, FO, FP, FQ, FR, FS, FT, FU, FV, FW, FX, FY, FZ; Xshort F0, F1, F2, F3; Xshort VA, VB, VC, VD, VE, VF, VG, VH, VI, VJ, VK, VL, VM; Xshort VN, VO, VP, VQ, VR, VS, VT, VU, VV, VW, VX, VY, VZ; Xshort V0, V1, V2, V3, V4, V5, V6, V7, V8, V9; Xlong PA, PB, PC, PD, PE, PF, PG, PH, PI, PJ, PK, PL, PM; Xlong PN, PO, PP, PQ, PR, PS, PT, PU, PV, PW, PX, PY, PZ; Xlong P0, P1, P2, P3, P4, P5, P6, P7, P8, P9; X /* */ Xvoid Stop ARGS((short, short, long)); Xvoid Oops ARGS((char *)); X /* */ Xvoid Stop ARGS3(short,flg,short,val,long,ptr) X{ X DEBUGF(7, "flg=%d, val=%d, ptr=%d=%080x, MEM=%08x" C flg C val X C ptr C ptr C MEM); /* DEBUGF continued */ X DEBUG_EXIT(); X PLStatus(1, "Stop!"); X PLExit(PLsev_error); X } X /* */ Xvoid Oops ARGS1(char*,s) X{ X PLStatus(1, "Oops:"); X PLStatus(1, s); X DEBUG_EXIT(); X PLExit(PLsev_error); X } X /* */ X/* BEGIN PROGRAM. */ X /* */ X> XEND PROGRAM. X/* END PROGRAM. */ X/* End of generated file */ X> XBEGIN MAIN ROUTINE. X/* BEGIN MAIN ROUTINE. */ Xshort DoIt() X{ X DEBUG_ENTER("MAIN ROUTINE", NULL); X F0 = 0; F1 = 1; F2 = 2; F3 = 3; X V0 = 0; V1 = 1; V2 = 2; V3 = 3; V4 = 4; X V5 = 5; V6 = 6; V7 = 7; V8 = 8; V9 = 9; X P0 = 0; P1 = 1; P2 = 2; P3 = 3; P4 = 4; X P5 = 5; P6 = 10; X P8 = ((long) MEM); X P9 = ((long) MEM) + sizeof(long) * MEMSIZ; X DEBUGF(5, "P8=%08x, P9=%08x" C P8 C P9); X MStartIO(PLargcnt, PLarglist); X> XEND MAIN ROUTINE. X/* END MAIN ROUTINE. */ X DEBUG_RETURN(NULL); X MStopIO(); X return 0; X } X> XBEGIN SUBROUTINE $. X/* BEGIN SUBROUTINE $10. */ Xvoid Sub$10(void); Xvoid Sub$10() X{ X DEBUG_ENTER("Sub$10", NULL); X> XEND SUBROUTINE $. X/* END SUBROUTINE $10. */ X DEBUG_RETURN(NULL); X return; X } X> XLABEL $$. X LABEL$10$20: XDEBUGF(5, "LABEL $10$20"); X> XCHRDATA $$ $ $ $$. X {unsigned f = $30, v = '$40', p = $50*10+$60; X MEM[$10*10+$20] = (v << 24) | ((f & 3) << 22) | (p & 0x3FFFFF);} X> XNUMDATA $$ $ $$ $$. X {unsigned f = $30, v = $40*10+$50, p = $60*10+$70; X MEM[$10*10+$20] = (v << 24) | ((f & 3) << 22) | (p & 0x3FFFFF);} X> XSTOP $. XDEBUGF(5, "STOP $10"); X Stop(F$10, V$10, P$10); X> XCALL $. XDEBUGF(5, "CALL $10"); X Sub$10(); X> XGET $ = MEM $. XDEBUGF(7, "GET $10 = MEM $20"); X if (P$20 < MEM || MEM + MEMSIZ <= P$20 || 0 != (P$20 & 3)) X Oops("Get $00 out of range: P$20"); X {long temp; X temp = * (long *) P$20; X V$10 = (temp >> 24) & 0xFF; X F$10 = (temp >> 22) & 0x03; X P$10 = (temp << 10) >> 10; /* do sign extend */ XDEBUGF(8, " Now, F$10=%d, V$10=%d, P$10=%d" C F$10 C V$10 C P$10); X } X> XPUT MEM $ = $. XDEBUGF(7, "PUT MEM $10 = $20"); X if (P$10 < MEM || MEM + MEMSIZ <= P$10 || 0 != (P$20 & 3)) X Oops("Put $00 out of range: P$10"); X {long temp; X temp = (V$20 << 24) | ((F$20 & 3) << 22) | (P$20 & 0x3FFFFF); X * (long *) P$10 = temp; XDEBUGF(8, " Put F$20=%d, V$20=%d, P$20=%d" C F$20 C V$20 C P$20); X } X> XFLG $ = $. XDEBUGF(7, "FLG $10 = $20"); X F$10 = F$20; XDEBUGF(8, " Now, F$10=%d" C F$10); X> XPTR $ = VAL $. XDEBUGF(7, "PTR $10 = VAL $20"); X P$10 = (V$20 & 0xFF); XDEBUGF(8, " Now, P$10=%d" C P$10); X> XVAL $ = PTR $. XDEBUGF(7, "VAL $10 = PTR $20"); X V$10 = (P$20 & 0xFF); XDEBUGF(8, " Now, V$10=%d" C V$10); X> XVAL $ = $ + $. XDEBUGF(7, "VAL $10 = $20 + $30"); X V$10 = V$20 + V$30; XDEBUGF(8, " Now, V$10=%d" C V$10); X> XVAL $ = $ - $. XDEBUGF(7, "VAL $10 = $20 - $30"); X V$10 = V$20 - V$30; XDEBUGF(8, " Now, V$10=%d" C V$10); X> XPTR $ = $ + $. XDEBUGF(7, "PTR $10 = $20 + $30"); X P$10 = P$20 + P$30; XDEBUGF(8, " Now, P$10=%d" C P$10); X> XPTR $ = $ - $. XDEBUGF(7, "PTR $10 = $20 - $30"); X P$10 = P$20 - P$30; XDEBUGF(8, " Now, P$10=%d" C P$10); X> XPTR $ = $ * $. XDEBUGF(7, "PTR $10 = $20 * $30"); X P$10 = P$20 * P$30; XDEBUGF(8, " Now, P$10=%d" C P$10); X> XPTR $ = $ / $. XDEBUGF(7, "PTR $10 = $20 / $30"); X P$10 = P$20 / P$30; XDEBUGF(8, " Now, P$10=%d" C P$10); X> XMOV PTR $ BY $. XDEBUGF(7, "MOV PTR $10 BY $20"); X P$10 = P$10 + sizeof(long) * P$20; XDEBUGF(8, " Now, P$10=%d=%08x" C P$10 C P$10); X> XTO $$. XDEBUGF(7, "TO $10$20"); X goto LABEL$10$20; X> XTO $$ IF FLG $ EQ $. XDEBUGF(7, "TO $10$20 IF FLG $30 EQ $40 (F$30=%d, F$40=%d)" C F$30 C F$40); X if (F$30 == F$40) goto LABEL$10$20; X> XTO $$ IF FLG $ NE $. XDEBUGF(7, "TO $10$20 IF FLG $30 NE $40 (F$30=%d, F$40=%d)" C F$30 C F$40); X if (F$30 != F$40) goto LABEL$10$20; X> XTO $$ IF VAL $ EQ $. XDEBUGF(7, "TO $10$20 IF VAL $30 EQ $40 (V$30=%d, V$40=%d)" C V$30 C V$40); X if (V$30 == V$40) goto LABEL$10$20; X> XTO $$ IF VAL $ NE $. XDEBUGF(7, "TO $10$20 IF VAL $30 NE $40 (V$30=%d, V$40=%d)" C V$30 C V$40); X if (V$30 != V$40) goto LABEL$10$20; X> XTO $$ IF PTR $ EQ $. XDEBUGF(7, "TO $10$20 IF PTR $30 EQ $40 (P$30=%d, P$40=%d)" C P$30 C P$40); X if (P$30 == P$40) goto LABEL$10$20; X> XTO $$ IF PTR $ NE $. XDEBUGF(7, "TO $10$20 IF PTR $30 NE $40 (P$30=%d, P$40=%d)" C P$30 C P$40); X if (P$30 != P$40) goto LABEL$10$20; X> XTO $$ IF PTR $ LT $. XDEBUGF(7, "TO $10$20 IF PTR $30 LT $40 (P$30=%d, P$40=%d)" C P$30 C P$40); X if (P$30 < P$40) goto LABEL$10$20; X> XREWIND $. XDEBUGF(7, "REWIND $10 (V$10=%d)" C V$10); X {long temp; X temp = MRewind(V$10); X if (temp == OK) F$10 = 0; else F$10 = 1; XDEBUGF(8, " Now, F$10=%d" C F$10); X } X> XGET BUFF $. XDEBUGF(7, "GET BUFF $10 (V$10=%d)" C V$10); X F$10 = MGetBuff(V$10); XDEBUGF(8, " Now, F$10=%d" C F$10); X> XPUT BUFF $. XDEBUGF(7, "PUT BUFF $10"); X F$10 = MPutBuff(V$10); XDEBUGF(8, " Now, F$10=%d" C F$10); X> XVAL $ = INPUT. XDEBUGF(7, "VAL $10 = INPUT"); X V$10 = MGetChar(); XDEBUGF(8, " Now, V$10=%d" C V$10); X> XOUTPUT = VAL $. XDEBUGF(7, "OUTPUT = VAL $10"); X V$10 = MPutChar(V$10); XDEBUGF(8, " Now, V$10=%d" C V$10); X> X. An empty line will match X> An empty line will generate nothing XDEBUG. X> The debug statement does nothing yet in compiled code XMESSAGE $$$$ TO $. XDEBUGF(7, "MESSAGE $10$20$30$40 TO $50"); X MPutChar(0); X {long temp; X for (temp = 0; temp < 20; temp++) X MPutChar('*'); X MPutChar($10); X MPutChar($20); X MPutChar($30); X MPutChar($40); X MPutChar(' '); X MPutChar('E'); X MPutChar('R'); X MPutChar('R'); X MPutChar('O'); X MPutChar('R'); X MPutChar('!'); X MPutChar(0); X temp = MPutBuff(V$50); X if (temp == OK) F$50 = 0; X else if (temp == EOF) F$50 = 1; X else if (temp == ILLEGAL) F$50 = 2; X } X> END_OF_FILE if test 7108 -ne `wc -c <'LOME/SCMdebug.mac'`; then echo shar: \"'LOME/SCMdebug.mac'\" unpacked with wrong size! fi # end of 'LOME/SCMdebug.mac' fi if test -f 'PPL/PPLUnix.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'PPL/PPLUnix.c'\" else echo shar: Extracting \"'PPL/PPLUnix.c'\" $6076 characters$ sed "s/^X//" >'PPL/PPLUnix.c' <<'END_OF_FILE' X/* X * PPLUnix.c X * Portable Programmer's Library General Host Code X * Unix version X * Copyright 1988, 1990 Darren New. All Rights Reserved. X * X * Started 19-Feb-88 DHN X * LastMod 07-jul-90 DHN X * X */ X X#include "PPL.h" X X X#define MAXARGC 20 /* max # args we are willing to remember */ X X XHIDDEN long memcount; X X Xvoid PLExit(short severity) X{ X exit((int) severity); X } X Xptr PLAllocMem(size, flags) X long size; X int flags; X{ X X#ifdef CHECKALLOC X X /* Note that this has some debugging stuff in it */ X /**** OLD -- MUST BE CHECKED!! ****/ X ptr retval; X inx i; X assert(size < BIGMEM); X retval = (ptr) malloc(size + sizeof(long) + sizeof(long) + (size & 1)); X if (retval == NULL) { X if (flags & PLalloc_die) { X bomb("Out of Memory"); X PLExit(PLsev_oores); X } X else X return retval; X } X else { X if (flags & PLalloc_zero) X for (i = size + 2 * sizeof(long) + (size & 1) - 1; 0 <= i; i--) X retval[i] = '\0'; X memcount += 1; X (* (long *) retval) = 0xA5A55A5A; X (* (long *) (retval + sizeof(long) + size + (size & 1))) = 0x5A5AA5A5; X return retval + sizeof(long); X } X X#else X X char * retval; X inx i; X assert(size < BIGMEM); X assert(size < 65530L); X assert(0 < size); X retval = malloc((unsigned) size); X if (retval == NULL) { X if (flags & PLalloc_die) { X bomb("Out of Memory"); X PLExit(PLsev_oores); X return NULL; /* to shut up compiler */ X } X else { X return NULL; X } X } X else { X if (flags & PLalloc_zero) { X for (i = 0; i < size; i++) { X retval[i] = '\0'; X } X } X memcount += 1; X return (ptr) retval; X } X X#endif X X } X X Xvoid PLFreeMem(where) X ptr where; X{ X X#ifdef CHECKALLOC X X /* note that this has some debugging stuff in it */ X assert(where != NULL); X where -= sizeof(long); X if (* (long *) where == 0x19919119) X bomb("Freed memory twice!"); X if (* (long *) where != 0xA5A55A5A) X bomb("Freed non-malloced memory!"); X (* (long *) where) = 0x19919119; X free(where); X memcount -= 1; X X#else X X extern void free(void *); X assert(where != NULL); X free(where); X memcount -= 1; X X#endif X X } X Xstr PLStrDup(s) X str s; X{ X str t; X t = PLAllocMem(strlen(s)+1, PLalloc_die); X strcpy((char *) t, (char *) s); X return t; X } X Xvoid PLCopyMem(to, from, siz) X ptr to; X ptr from; X long siz; X{ X /* be lazy and use lattice function here */ X extern void *memcpy(void *, void *, unsigned); X assert(0 < siz); X assert(siz < BIGMEM); X assert(NULL != to); X assert(NULL != from); X (void) memcpy((char *) to, (char *) from, (unsigned) siz); X } X Xvoid PLFillMem(ptr where, long siz, char chr) X{ X char * whr = where; X assert(whr != NULL); X assert(0 < siz); X assert(siz < 32760); X assert(siz < BIGMEM); X X /* setmem((char *) where, (unsigned) siz, chr); */ X X /* I don't trust Lattice at this point... */ X while (0 < siz--) X *whr++ = chr; X } X Xptr PLFindMem(ptr where, long siz, char chr) X{ X extern void *memchr(void *, int, unsigned); X assert(where != NULL); X assert(0 < siz); X assert(siz < BIGMEM); X return (ptr) memchr((char *) where, chr, (unsigned) siz); X } X X X/* The error strings: */ XHIDDEN str PLerrstrs[] = { X /* 0*/ "No Error", X /* 1*/ "DOS error (retryable)", X /* 2*/ "DOS error (wait/retry)", X /* 3*/ "DOS error (please fix)", X /* 4*/ "DOS error (failure)", X /* 5*/ "Program fault", X /* 6*/ "End of data during input", X /* 7*/ "Out of resource during output", X /* 8*/ "Multiple errors occured without being cleared", X /* 9*/ "Item does not exist", X /*10*/ "Item already exists", X /*11*/ "You are not allowed to do that", X /*12*/ "That opperation is not supported here", X /*13*/ "Item is busy", X /*14*/ "Item name missing or incorrectly formed", X /*15*/ "Not Yet Implemented", X /*16*/ "Cannot be Implemented", X /*17*/ "Argument to internal function semantically invalid", X /*18*/ "Overflow error", X /*19*/ "Underflow error", X /*20*/ "User break or interrupted system call", X /*21*/ "Error number out of range", X NULL X }; X XPLerr_enum PLerr; X Xint OSerr; X X/* The file and line of the last error (mainly for debugging) */ Xstr PLerr_file; Xlong PLerr_line; X Xstr PLErrText() X{ X if ( PLerr < 0 || PLerr_last < PLerr ) X PLerr = PLerr_last; X return PLerrstrs[PLerr]; X } X Xstr PLOSErrText() X{ X extern char * sys_errlist[]; X extern int sys_nerr; X X if (OSerr < 0 || sys_nerr <= OSerr) X return "PSoserrtext bad OSerr number"; X else X return sys_errlist[OSerr]; X } X Xshort PLstatuslevel = 6; X Xvoid PLStatus(short level, str message) X{ X if (PLstatuslevel < level) X return; X if (PLcmdname && *PLcmdname) { X fprintf(stderr, "%s: ", PLcmdname); X } X fprintf(stderr, "%s\n", message); X fflush(stderr); X } X Xvoid PLDelay(short secs) X{ X assert(0 <= secs); X if (secs != 0) X (void) sleep((unsigned) secs); X } X Xvoid PLBeep(short how) X{ X fprintf(stderr, "\a"); X } X X X/* This gives the name of the command, if available. X */ Xstr PLcmdname; X X/* This gives the host-syntax filename for the executable file, X * if available. X */ Xstr PLcmdfile; X X/* This tells how many command-line arguments there were, excluding X * the command name. X */ Xshort PLargcnt; X X/* This is the array of command-line argument strings. X */ Xstr PLarglist[MAXARGC]; X X/* These are the flags describing the command-line parameters. X */ Xlong PLargflags; X X/* Here is the main() that sets all this up, calls DoIt() and exits. X */ X X#if HIDPROTS Xvoid main ARGS((int argc, char * argv[])); X#endif X Xvoid main(int argc, char * argv[]) X{ X X /* Eventually, we will want to init PLstatuslevel from an env var X or something similar. */ X X if (0 < argc) { X char * cp; X inx i; X cp = argv[0] + strlen(argv[0]) - 1; X while (argv[0] < cp && *cp != '/' && *cp != ':') X cp -= 1; X PLcmdname = cp; X PLargcnt = argc - 1; X for (i = 1; i < argc && i < MAXARGC; i++) X PLarglist[i-1] = argv[i]; X } X PLcmdname = argv[0]; X PLExit(DoIt()); X } X X X/************* END OF FILE ***************/ X END_OF_FILE if test 6076 -ne `wc -c <'PPL/PPLUnix.c'`; then echo shar: \"'PPL/PPLUnix.c'\" unpacked with wrong size! fi # end of 'PPL/PPLUnix.c' fi if test -f 'TFS/TFS.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'TFS/TFS.h'\" else echo shar: Extracting \"'TFS/TFS.h'\" $6101 characters$ sed "s/^X//" >'TFS/TFS.h' <<'END_OF_FILE' X/* X * TFS.h X * Portable Programmer's Library Text File Subsystem Header File X * Copyright 1988 Darren New. All Rights Reserved. X * X * Started: 26-Feb-88 DHN X * LastMod: 05-jan-90 DHN X * X */ X X#ifndef TFS_h X#define TFS_h X Xtypedef long TFSfile; /* a handle to a file */ Xtypedef long TFSnote; /* file position information */ X X X/* X * This initialized anything the TFS might need. Do not call this X * twice in a row. If this detects an error, it will bomb(). X */ Xextern void TFSInit ARGS((void)); X X/* X * This returns TRUE if TFS has been initialized, FALSE if not. X */ Xextern bool TFSHasBeenInit ARGS((void)); X X/* X * This allows a gracefull cleanup of anything TFSInit() may have X * done. It is not guaranteed to close all TFS files, but it might. X */ Xextern void TFSTerm ARGS((void)); X X X/* This opens a text file. It returns a zero on failure, with the X * appropriate PLerr set. It returns non-zero on success, and expects X * the returned value to be passed to all the other routines below. X * The FNAME parameter is the textual representation of the file name X * as the user selected it. Note that this is allowed to have strange X * stuff in it, as long as these routines know what is going on. X * The FNAME is expected to be a NUL-teminated string, as is the MODE. X * The following characters are legal in the MODE string: X * L - Locate (return TFSfile or error without actually opening) X * C - Create (if file did not exist, create it; if it did, ignore this) X * T - Truncate (if file did exist, truncate it; if not, ignore this) X * A - Append (if file did exist, append to it; if not, ignore this) X * R - Read (file is allowed to be read) X * W - Write (file is allowed to be written) X * P - Position (file is allowed to be positioned (TFSNote and TFSPoint)) X * D - Destroy (file is allowed to be destroyed instead of closed) X * X * L may be combined with any other command. The file will be checked X * for the proper permissions, but will not be opened. X * P is applicable only with R, and if absent may cause TFSInfo() to X * return less information than if present. If P is present and the X * file is on a non-"seekable" device (e.g., a terminal), an error may X * be returned then or at the time of the position. X * T and A are mutually exclusive, and if W is present one of T or A must X * also be present; T and A are not allowed without W. X * R and W are mutually exclusive. X * Note that C and A are not exclusive; neither are C and D, or C and T, X * or C and R (which makes an empty file open for reading if it is not X * already existant). X */ Xextern TFSfile TFSOpen ARGS((str fname, str mode)); X X/* This closes a text file. It returns a FALSE on failure, with the X * appropriate PLerr set; it returns TRUE on success. X * It is a "bombable" error to pass an unopen file (or invalid handle) X * to this routine. X * It does not destroy the data in the file, even if "D" was X * specified during TFSOpen(). It merely disconnects X * the file and allows others to use it. It deallocates any buffers X * obtained from TFSOpen() and so on. X */ Xextern bool TFSClose ARGS((TFSfile handle)); X X/* This destroys a text file. It returns a FALSE on failure, with the X * appropriate PLerr set; it returns TRUE on success. The file X * must have been previously opened by TFSOpen() with "D" in the mode. X * It is a "bombable" error to pass an invalid or unopen handle to this. X * No other permissions are required in the mode, but they may be X * required by the host operating system. X * The handle is invalid (closed) after a call to this routine, even if X * the routine returned an error. X */ Xextern bool TFSDestroy ARGS((TFSfile handle)); X X/* @$@$ XTFSInfo() - Determine file parameters. This may return various Xparameters about the given file. The description of the information Xreturned is given in the TFS.h file. X*/ X X/* Read a line. Only entire lines are read. A '\0' is appened to X * the buffer. Lines longer than BIGLINE - 1 get truncated with an X * error return. The return is the number of characters read excluding X * the NUL appended by the read. The record separator is never returned. X * End-of-file is indicated by a return of -1 with PLerr set to PLerr_eod. X * All errors return with a zero-length string in buf. X * It is a "bombable" error to pass an unopen or invalid handle to this. X * All other errors are also indicated by a return of -1 with the error X * code in PLerr. NOTE: Trailing whitespace (a la isspace()) is X * eliminated from the buffer before returning. The line, INCLUDING X * TRAILING WHITESPACE, must have a length of less than BIGLINE - 1. X * The returned buffer is guaranteed to meet strlen(buf) < BIGLINE. X */ Xextern short TFSRead ARGS((TFSfile handle, str buf)); X X/* Write a line. Only entire lines are written. BUF must be NUL terminated. X * The return is TRUE for a successful write or FALSE with PLerr set if X * an error occured. The BUF must have strlen < BIGLINE - 1. X * Trailing whitespace (a la isspace()) in the buffer will be discarded X * on output without change to the buffer. X * It is a "bombable" error to pass an unopen or invalid handle to this. X */ Xextern bool TFSWrite ARGS((TFSfile handle, str buf)); X X/* Remember where the file is positioned. This returns a long value that X * can be passed to TFSPoint() to reposition the file in such a way that X * the same line will be read after TFSNote() and TFSPoint(). Note that X * this value is valid for this TFSOpen() only; i.e., this can NOT be X * saved when the file is closed, and it can NOT be applied to a X * different file. X * It is a "bombable" error to pass an unopen or invalid handle to this. X * The format of the TFSnote returned is a long, but the only values X * usable by the application are zero and non-zero; a return of zero X * indicates an error occured, and a return of non-zero indicates X * success. X */ Xextern long TFSNote ARGS((TFSfile handle)); X X/* Reposition a file -- see TFSNote(). Returns TRUE for success, FALSE X * for error. X * It is a "bombable" error to pass an unopen or invalid handle to this. X */ Xextern bool TFSPoint ARGS((TFSfile handle, TFSnote pos)); X X X#endif /* TFS_h */ X END_OF_FILE if test 6101 -ne `wc -c <'TFS/TFS.h'`; then echo shar: \"'TFS/TFS.h'\" unpacked with wrong size! fi # end of 'TFS/TFS.h' fi echo shar: End of archive 4 $of 9$. cp /dev/null ark4isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 9 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 -- --- Darren New --- Grad Student --- CIS --- Univ. of Delaware --- exit 0 # Just in case... -- Please send comp.sources.unix-related mail to rsalz@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.